#!/usr/bin/perl -wc

package RFCMail::ESMTP::Server::Policy::Users;

use strict;
use RFCMail::Util::Users;


my %POLICY =
    (
     'refuse' => sub { [550, "5.7.1 Declined for policy reasons"] },
     'accept' => sub { [250, "OK"] },
     'postpone' => sub { [450, "Temporarily unavailable"] },
    );


sub init {
    my $self = shift;
    $self->SUPER::init(@_);
    if (defined($self->{users})) {
	$self->{users} = RFCMail::Util::Users->from_perl($self->{users})
	    if not ref($self->{users});
    }
    else {
	$self->{users} = RFCMail::Util::Users->new;
    }
}


# There are no mail_from policy checks in the user class at this
# time, but an obvious addition would be a "blocked senders" list.


sub local_mailbox {
    my $self = shift;
    my $result = $self->SUPER::local_mailbox(@_);
    return ($result)
	if $result->[0] > 500;
    my ($mailbox) = @_;
    $result = eval {
	my ($lp, $dp) = @$mailbox;
	my $u = $self->{users}->{$dp};
	return ([550, "5.1.2 This server does not handle mail for domain $dp"])
	    if not defined($u);
	$u = $u->{$lp};
	return ([550, "5.1.1 No such mailbox here"])
	    if not defined($u);
	$u = $u->{policies};
	return ([250, "<$lp\@$dp> accepts"])
	    if not defined($u);
	my $target = $self->{state}->{DNSBL_IP};
	if (not defined($target)) {
	    $self->logmsg(w => "unable to enforce dnsbl policy: no DNSBL_IP in state table");
	    return ([250, "<$lp\@$dp> accepts"]);
	}
	while (my ($name, $policy) = each %$u) {
	    my $dnsbl_ip = $policy->{dnsbl_ip};
	    next if not defined($dnsbl_ip);
	    while (my ($dnsbl, $action) = each %$dnsbl_ip) {
		return (&{$POLICY{$action}})
		    if $target->hits($dnsbl);
	    }
	}
	return ([250, "<$lp\@$dp> accepts"]);
    };
    return ($result);
}


sub rcpt_add {
    my $self = shift;
    $self->SUPER::rcpt_add(@_);
    my ($rcpt) = @_;
    return ()
	if not $rcpt->is_path;
    my ($lp, $dp) = @$rcpt;
    my $handlers = $self->{users}->{$dp}->{$lp}->{handlers};
    return ()
	if not defined($handlers);
    my $here = $self->{state};
    $here->{handlers} = {}
	if not defined($here->{handlers});
    $here = $here->{handlers};
    while (my ($k, $v) = each %$handlers) {
	$here->{$k} = $v;
    }
}


1;
